home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / network / info-sys / www / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / tix / Filebox.tcl < prev    next >
Encoding:
Text File  |  1995-02-12  |  15.4 KB  |  599 lines
  1. proc tixFileSelectbox {w args} {
  2.     eval tixInt_CreateWidget $w tixFsb TixFileSelectbox $args
  3.     return $w
  4. }
  5.  
  6. proc tixFileSelectBox {w args} {
  7.     eval tixInt_CreateWidget $w tixFsb TixFileSelectbox $args
  8.     return $w
  9. }
  10.  
  11. proc tixFsb::CreateClassRec {} {
  12.   global tixFsb
  13.  
  14.   # OPTIONS
  15.   set tixFsb(rootOptions)   {}
  16.   set tixFsb(options)       {-command -browsecmd -pattern -selection
  17.                      -filter -grab
  18.                  -entrybg -entryfont
  19.                  -listboxbg -listboxfont
  20.                  -font -background -foreground -bg -fg
  21.                 }
  22.   # DEFAULT VALUES
  23.   set tixFsb(-browsecmd)    {-browsecmd browseCmd BrowseCmd {}}
  24.   set tixFsb(-command)      {-command command Command {}}
  25.   set tixFsb(-selection)    {-selection selection Selection {}}
  26.   set tixFsb(-filter)       {-filter filter Filter {}}
  27.   set tixFsb(-pattern)      {-pattern pattern Pattern *}
  28.   set tixFsb(-grab)         {-grab grab Grab global}
  29.  
  30.   # Sub widget options
  31.   set tixFsb(-font)         {-font font Font \
  32.                          "-*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  33.   set tixFsb(-background)   {-background background Background #ffe4c4}
  34.   set tixFsb(-foreground)   {-foreground foreground Foreground black}
  35.   set tixFsb(-entrybg)      {-entrybg entryBg Background #ffe4c4}
  36.   set tixFsb(-entryfont)    {-entryfont entryFont Font \
  37.                          "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  38.   set tixFsb(-listboxbg)    {-listboxbg listboxBg Background #ffe4c4}
  39.   set tixFsb(-listboxfont)  {-listboxfont listboxFont Font \
  40.                          "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  41.  
  42.   # ALIASES
  43.   set tixFsb(-bg)           {= -background}
  44.   set tixFsb(-fg)           {= -foreground}
  45.  
  46.   # METHODS
  47.   set tixFsb(methods)       {filter invoke}
  48. }
  49.  
  50.  
  51. proc tixFsb::InitWidgetRec {w class className args} {
  52.     upvar #0 $w data
  53.  
  54.     set data(pwd)     [pwd]
  55.     if {$data(-filter) == {}} {
  56.     set data(-filter) $data(pwd)/$data(-pattern)
  57.     }
  58.     set data(exposed)   0
  59.     set data(flag)      0
  60.     set data(w_dirMenu) $w.dirmenu
  61. }
  62.  
  63. proc tixFsb::SetBindings {w} {
  64.     upvar #0 $w data
  65.  
  66.     bind $w <Expose> "tixFsb::Expose $w"
  67. }
  68.  
  69. #----------------------------------------------------------------------
  70. #        Construct widget
  71. #----------------------------------------------------------------------
  72. proc tixFsb::ConstructWidget {w} {
  73.     upvar #0 $w data
  74.  
  75.     set frame1 [tixFsb::CreateFrame1 $w]
  76.     set frame2 [tixFsb::CreateFrame2 $w]
  77.     set frame3 [tixFsb::CreateFrame3 $w]
  78.  
  79.     pack $frame1 -in $w -side top -fill x
  80.     pack $frame3 -in $w -side bottom -fill x
  81.     pack $frame2 -in $w -side top -fill both -expand yes
  82.  
  83.     # Binding of List box 1 (dir)
  84.     #----------------------------
  85.     set list1 [$data(box1) listbox]
  86.     bind $list1 <1>         "tixFsb::SelectDir $w %W %y"
  87.     bind $list1 <B1-Motion> "tixFsb::SelectDir $w %W %y"
  88.     bind $list1 <Double-ButtonPress-1> "tixFsb::InvokeDir $w %W %y"
  89.     global tix_priv
  90.     if [info exists tix_priv(as_loaded)] {
  91.     tixAutoS_BindListboxSingle $list1
  92.     }
  93.  
  94.     # Binding of List box 2 (file)
  95.     #-----------------------------
  96.     set list2 [$data(box2) listbox]
  97.     bind $list2 <1>         "tixFsb::SelectFile $w %W %y"
  98.     bind $list2 <B1-Motion> "tixFsb::SelectFile $w %W %y"
  99.     bind $list2 <Double-ButtonPress-1> "$w invoke"
  100.     if [info exists tix_priv(as_loaded)] {
  101.     tixAutoS_BindListboxSingle $list2
  102.     }
  103. }
  104.  
  105. proc tixFsb::CreateFrame1 {w} {
  106.     upvar #0 $w data
  107.  
  108.     frame $w.f1 -border 10 -bg $data(-background)
  109.     label $w.f1.l1 -text "Filter"\
  110.     -font $data(-font) \
  111.     -bg $data(-background) \
  112.     -fg $data(-foreground)
  113.     tixCombobox $w.f1.cbx -type history \
  114.     -command "$data(root) filter" -height 5 -scrollbar auto -anchor e \
  115.     -entrybg $data(-entrybg) \
  116.     -entryfont $data(-entryfont) \
  117.     -listboxbg $data(-listboxbg) \
  118.     -listboxfont $data(-listboxfont)
  119.     pack $w.f1.l1 $w.f1.cbx -side top -expand yes -fill both
  120.  
  121.     set data(w_cbxFil) $w.f1.cbx
  122.     lappend data(subwidgets) $w.f1 $w.f1.l1 $w.f1.cbx
  123.     lappend data(labels) $w.f1.l1
  124.  
  125.     $w.f1.cbx addhistory $data(pwd)/*
  126.     return $w.f1
  127. }
  128.  
  129. proc tixFsb::CreateFrame2 {w} {
  130.     upvar #0 $w data
  131.  
  132.     frame $w.f2 -border 10 -bg $data(-background)
  133.     #     THE LEFT FRAME
  134.     #-----------------------
  135.     frame $w.f2a -bg $data(-background)
  136.     label $w.f2a.lab -text "Directories" \
  137.     -bg $data(-background) \
  138.     -fg $data(-foreground) \
  139.     -font $data(-font)
  140.     tixScrolledListbox $w.f2a.sbox -geometry 8x6 \
  141.     -bg $data(-background) \
  142.     -listboxbg $data(-listboxbg) \
  143.     -font $data(-listboxfont) \
  144.     -fg $data(-foreground)
  145.  
  146.     pack $w.f2a.lab   -side top                -fill x
  147.     pack $w.f2a.sbox  -side bottom -expand yes -fill both
  148.  
  149.     #     THE RIGHT FRAME
  150.     #-----------------------
  151.     frame $w.f2b -bg $data(-background)
  152.     label $w.f2b.lab -text "Files" \
  153.     -bg $data(-background) \
  154.     -fg $data(-foreground) \
  155.     -font $data(-font)
  156.     tixScrolledListbox $w.f2b.sbox -geom 8x6 \
  157.     -bg $data(-background) \
  158.     -listboxbg $data(-listboxbg) \
  159.     -font $data(-listboxfont) \
  160.     -fg $data(-foreground)
  161.  
  162.  
  163.     pack $w.f2b.lab  -side top                -fill x
  164.     pack $w.f2b.sbox -side bottom -expand yes -fill both
  165.  
  166.     # used to make some width between the listboxes
  167.     #----------------------------------------------
  168.     label $w.f2labx -width 1 -bg $data(-background)
  169.  
  170.     pack $w.f2a    -in $w.f2 -side left -fill both -expand yes
  171.     pack $w.f2labx -in $w.f2 -side left -fill y
  172.     pack $w.f2b    -in $w.f2 -side left -fill both -expand yes
  173.  
  174.     set data(box1)  $w.f2a.sbox
  175.     set data(box2)  $w.f2b.sbox
  176.     set data(dummy) $w.f2a.lab
  177.  
  178.     lappend data(subwidgets) $w.f2 \
  179.     $w.f2a $w.f2a.lab $w.f2a.sbox \
  180.     $w.f2b $w.f2b.lab $w.f2b.sbox \
  181.     $w.f2labx
  182.     lappend data(labels) $w.f2a.lab $w.f2b.lab 
  183.  
  184.     return $w.f2
  185. }
  186.  
  187. proc tixFsb::CreateFrame3 {w} {
  188.     upvar #0 $w data
  189.  
  190.     frame $w.f3 -border 10 -bg $data(-background)
  191.     label $w.f3.l1 -text "Selection" \
  192.     -font $data(-font) \
  193.     -bg $data(-background) \
  194.     -fg $data(-foreground)
  195.     tixCombobox $w.f3.cbx -type history \
  196.     -command "$data(root) invoke" -height 5 -scrollbar auto -anchor e \
  197.     -entrybg $data(-entrybg) \
  198.     -entryfont $data(-entryfont) \
  199.     -listboxbg $data(-listboxbg) \
  200.     -listboxfont $data(-listboxfont)
  201.     pack $w.f3.l1 $w.f3.cbx -side top -fill both
  202.  
  203.     set data(w_cbxSel) $w.f3.cbx
  204.  
  205.     lappend data(subwidgets) $w.f3 $w.f3.l1 $w.f3.cbx
  206.     lappend data(labels) $w.f3.l1
  207.  
  208.     return $w.f3
  209. }
  210.  
  211. #----------------------------------------------------------------------
  212. #                           CONFIG OPTIONS
  213. #----------------------------------------------------------------------
  214. # Set the filter to the real  directory (resolve all symlinks)
  215. #
  216. proc tixFsb::config-filter {w arg} {
  217.     upvar #0 $w data
  218.  
  219.     set tmp [pwd]
  220.     catch {
  221.     cd [file dirname $arg]
  222.     set data(pwd) [pwd]
  223.     }
  224.     cd $tmp
  225.  
  226.     set data(-pattern) [file tail $arg]
  227.     if {$data(pwd) == "/"} {
  228.     set data(-filter) /$data(-pattern)
  229.     } else {
  230.     set data(-filter) $data(pwd)/$data(-pattern)
  231.     }
  232.  
  233.     $data(w_cbxFil) entry set $data(-filter)
  234. }
  235.  
  236. proc tixFsb::config-selection {w arg} {
  237.     upvar #0 $w data
  238.     $data(w_cbxSel) entry set $arg
  239. }
  240.  
  241. proc tixFsb::config-pattern {w arg} {
  242.     upvar #0 $w data
  243.     set dir [file dirname [$data(w_cbxFil) entry get]]
  244.     if {$dir == "/"} {
  245.     $data(w_cbxFil) entry set /$arg
  246.     } else {
  247.     $data(w_cbxFil) entry set $dir/$arg
  248.     }
  249. }
  250.  
  251. proc tixFsb::config-background {w arg} {
  252.     upvar #0 $w data
  253.  
  254.     $data(rootCmd) config -bg $arg 
  255.     foreach subw $data(subwidgets) {
  256.     $subw config -bg $arg
  257.     }
  258.     $data(box1) config -scrollbarfg $arg
  259.     $data(box2) config -scrollbarfg $arg
  260. }
  261.  
  262. proc tixFsb::config-foreground {w arg} {
  263.     upvar #0 $w data
  264.  
  265.     foreach label $data(labels) {
  266.     $label config -fg $arg
  267.     }
  268.     $data(w_cbxFil) config -fg $arg
  269.     $data(w_cbxSel) config -fg $arg
  270.     $data(box1) config -fg $arg
  271.     $data(box2) config -fg $arg
  272. }
  273.  
  274. proc tixFsb::config-font {w arg} {
  275.     upvar #0 $w data
  276.  
  277.     foreach label $data(labels) {
  278.     $label config -font $arg
  279.     }
  280. }
  281.  
  282. proc tixFsb::config-listboxbg {w arg} {
  283.     upvar #0 $w data
  284.  
  285.     $data(w_cbxFil) config -listboxbg $arg
  286.     $data(w_cbxSel) config -listboxbg $arg
  287.     $data(box1) config -listboxbg $arg
  288.     $data(box2) config -listboxbg $arg
  289.     $data(box1) config -scrollbarbg $arg
  290.     $data(box2) config -scrollbarbg $arg
  291. }
  292.  
  293. proc tixFsb::config-listboxfont {w arg} {
  294.     upvar #0 $w data
  295.  
  296.     $data(w_cbxFil) config -listboxfont $arg
  297.     $data(w_cbxSel) config -listboxfont $arg
  298.     $data(box2) config -font $arg
  299.     $data(box2) config -font $arg
  300. }
  301.  
  302. proc tixFsb::config-entrybg {w arg} {
  303.     upvar #0 $w data
  304.  
  305.     $data(w_cbxFil) config -entrybg $arg
  306.     $data(w_cbxSel) config -entrybg $arg
  307. }
  308.  
  309. proc tixFsb::config-listboxfont {w arg} {
  310.     upvar #0 $w data
  311.  
  312.     $data(w_cbxFil) config -entryfont $arg
  313.     $data(w_cbxSel) config -entryfont $arg
  314. }
  315.  
  316. #----------------------------------------------------------------------
  317. #                    INTERNAL METHODS
  318. #----------------------------------------------------------------------
  319. proc tixFsb::LoadDirIntoLists {w} {
  320.     upvar #0 $w data
  321.  
  322.     $data(box1) listbox delete 0 end
  323.     $data(box2) listbox delete 0 end
  324.  
  325.     set tmp [pwd]
  326.     cd $data(pwd)
  327.  
  328.     foreach i [lsort [glob -nocomplain * .*]] {
  329.     set fname [file tail $i]
  330.     if [file isdirectory $data(pwd)/$fname] {
  331.         $data(box1) listbox insert end $fname
  332.     }
  333.     }
  334.  
  335.     set data(-filter) [$data(w_cbxFil) entry get]
  336.  
  337.     set top 0
  338.  
  339.     # force glob to list the .* files. However, since the use might not
  340.     # be interested in them, put the "normal" files at the top of the listbox
  341.  
  342.     if {$data(-pattern) == "*"} {
  343.     foreach i [lsort [glob -nocomplain * .*]] {
  344.         set fname [file tail $i]
  345.         if {![file isdirectory $data(pwd)/$fname]} {
  346.         $data(box2) listbox insert end $fname
  347.         if {[string index $fname 0] == "."} {
  348.             incr top
  349.         }
  350.         }
  351.     }
  352.     } else {
  353.     foreach i [lsort [glob -nocomplain $data(-filter)]] {
  354.         set fname [file tail $i]
  355.         if {![file isdirectory $data(pwd)/$fname]} {
  356.         $data(box2) listbox insert end $fname
  357.         }
  358.     }
  359.     }
  360.  
  361.     $data(box2) listbox yview $top
  362.     cd $tmp
  363. }
  364.  
  365. proc tixFsb::LoadDir {w} {
  366.     upvar #0 $w data
  367.     global TIX_SOURCE_DIR
  368.  
  369.     # Sets a grab to $data(dummy), which is a label, so that the 
  370.     # application won't respond to any event during the time the file names
  371.     # are being loaded in. I use a nasty global grab here. I will try to 
  372.     # do it with a localk grab but so far I haven't succeeded.
  373.     update idletasks
  374.  
  375.     case $data(-grab) {
  376.     global {
  377.         grab -global $data(dummy)
  378.         $data(dummy) config -cursor \
  379.         "@$TIX_SOURCE_DIR/bitmaps/hourglass \
  380.          $TIX_SOURCE_DIR/bitmaps/hourglass \
  381.          red white"
  382.     }
  383.     local {
  384.         grab $data(dummy)
  385.     }
  386.     }
  387.  
  388.     catch {
  389.     # Just in case some error happens inside grab, don't
  390.     # want to make the X server inaccessible
  391.  
  392.     update idletasks
  393.     catch {
  394.         tixFsb::LoadDirIntoLists $w
  395.     } err
  396.  
  397.     # If the user enters an invalid directory, clean up the mess, restore
  398.     # the filter and attempt to reload the files
  399.     #--------------------------------------------------------------------
  400.     if {$err != {}} {
  401.         set data(-filter) [$data(w_cbxFil) entry get]
  402.         set ftail [file tail $data(-filter)]
  403.         if {$data(pwd) == "/"} {
  404.         set data(-filter) /$ftail
  405.         } else {
  406.         set data(-filter) $data(pwd)/$ftail
  407.         }
  408.         $data(w_cbxFil) entry set $data(-filter)
  409.         catch {
  410.         tixFsb::LoadDirIntoLists $w
  411.         }
  412.     }
  413.  
  414.     tixFsb::MkDirMenu $w
  415.  
  416.     # process (and discard) all events when the file names were being 
  417.     # loaded in, then release the grab
  418.  
  419.     update
  420.     $data(dummy) config -cursor {}
  421.     grab release $data(dummy) 
  422.     } err
  423.  
  424.     if {$err != {}} {
  425.     grab release $data(dummy) 
  426.     $data(dummy) config -cursor {}
  427.     error $err
  428.     }
  429. }
  430.  
  431. proc tixFsb::MkDirMenu {w} {
  432.     upvar #0 $w data
  433.  
  434.     if [winfo exists $data(w_dirMenu)] {
  435.     destroy $data(w_dirMenu)
  436.     }
  437.     tixCreatePopupMenu $data(w_dirMenu) Directories "tixFsb::MkDirMenuProc $w"
  438.     tixPupBindParents $data(w_dirMenu) [$data(w_cbxFil) entry]
  439. }
  440.  
  441. proc tixFsb::MkDirMenuProc {w m} {
  442.     upvar #0 $w data
  443.  
  444.     set f $data(pwd)
  445.  
  446.     menu $m
  447.     while {$f != "/"} {
  448.     set name "$f/$data(-pattern)"
  449.     $m add command -label $name -command "tixFsb::MenuInvokeDir $w $name"
  450.     set f [file dirname $f]
  451.     }
  452.     $m add command -label $f/$data(-pattern)
  453. }
  454.  
  455. proc tixFsb::SelectDir {w dir_list y} {
  456.     upvar #0 $w data
  457.  
  458.     set data(-filter) [$data(w_cbxFil) entry get]
  459.     set data(-pattern) [file tail $data(-filter)]
  460.  
  461.     $dir_list select from [$dir_list nearest $y]
  462.     $dir_list select to [$dir_list nearest $y]
  463.     set subdir [$dir_list get [$dir_list nearest $y]]
  464.     if {$data(pwd) == "/"} {
  465.     set data(-filter) /$subdir/$data(-pattern)
  466.     } else {
  467.     set data(-filter) $data(pwd)/$subdir/$data(-pattern)
  468.     }
  469.     $data(w_cbxFil) entry set $data(-filter)
  470. }
  471.  
  472. proc tixFsb::InvokeDir {w dir_list y} {
  473.     upvar #0 $w data
  474.  
  475.     set data(-filter) [$data(w_cbxFil) entry get]
  476.     set data(-pattern) [file tail $data(-filter)]
  477.  
  478.     $dir_list select from [$dir_list nearest $y]
  479.     $dir_list select to [$dir_list nearest $y]
  480.     set tmp [pwd]
  481.     catch {
  482.     cd $data(pwd)
  483.     cd [$dir_list get [$dir_list nearest $y]]
  484.     set data(pwd) [pwd]
  485.     }
  486.     cd $tmp
  487.  
  488.     if {$data(pwd) == "/"} {
  489.     set data(-filter) /$data(-pattern)
  490.     } else {
  491.     set data(-filter) $data(pwd)/$data(-pattern)
  492.     }
  493.     $data(w_cbxFil) entry set $data(-filter)
  494.     tixFsb::LoadDir $w
  495. }
  496.  
  497. proc tixFsb::MenuInvokeDir {w filter} {
  498.     upvar #0 $w data
  499.  
  500.     set data(-filter) $filter
  501.     set data(pwd) [file dirname $filter]
  502.     $data(w_cbxFil) entry set $filter
  503.  
  504.     tixFsb::LoadDir $w
  505. }
  506.  
  507. proc tixFsb::filter {w args} {
  508.     upvar #0 $w data
  509.  
  510.     set data(-filter)  [$data(w_cbxFil) entry get]
  511.     set data(-pattern) [file tail $data(-filter)]
  512.     set tmp [pwd]
  513.     catch {
  514.     cd $data(pwd)
  515.     cd [file dirname $data(-filter)]
  516.     set data(pwd) [pwd]
  517.     }
  518.     cd $tmp
  519.  
  520.     tixFsb::LoadDir $w
  521. }
  522.  
  523. proc tixFsb::SelectFile {w file_list y} {
  524.     upvar #0 $w data
  525.  
  526.     $file_list select from [$file_list nearest $y]
  527.     $file_list select to [$file_list nearest $y]
  528.     set selected [$file_list get [$file_list nearest $y]]
  529.  
  530.     if {$data(pwd) == "/"} {
  531.     $data(w_cbxSel) entry set /$selected
  532.     set $data(-selection) /$selected
  533.     } else {
  534.     $data(w_cbxSel) entry set $data(pwd)/$selected
  535.     set $data(-selection) $data(pwd)/$selected
  536.     }
  537.     if {$data(-browsecmd) != {}} {
  538.     eval $data(-browsecmd) [$data(w_cbxSel) entry get]
  539.     }
  540. }
  541.  
  542. proc tixFsb::invoke {w args} {
  543.     upvar #0 $w data
  544.  
  545.     $data(w_cbxFil) addhistory $data(-filter)
  546.     set data(-filter) [$data(w_cbxFil) entry get]
  547.  
  548.     $data(w_cbxSel) addhistory [$data(w_cbxSel) entry get]
  549.     set data(-selection) [$data(w_cbxSel) entry get]
  550.  
  551.     if {$data(-command) != {}} {
  552.     eval $data(-command) [list [$data(w_cbxSel) entry get]]
  553.     }
  554. }
  555.  
  556. proc tixFsb::Expose {w} {
  557.     upvar #0 $w data
  558.  
  559.     if {$data(exposed) == 0} {
  560.     set data(exposed) 1
  561.     $data(w_cbxFil) entry set $data(-filter)
  562.     tixFsb::LoadDir $w
  563.     $data(w_cbxFil) align
  564.     }
  565. }
  566.  
  567. #----------------------------------------------------------------------
  568. #
  569. #
  570. #              C O N V E N I E N C E   R O U T I N E S 
  571. #
  572. #
  573. #----------------------------------------------------------------------
  574. proc tixMkFileDialog {
  575.     w
  576.     okcmd
  577.     {helpcmd      {}} } \
  578. {
  579.     toplevel $w
  580.     wm minsize $w 10 10
  581.  
  582.     tixStdDlgBtns $w.btns
  583.     tixFileSelectbox $w.fsb -command "wm withdraw $w; $okcmd"
  584.  
  585.     $w.btns button ok     config -command "$w.fsb invoke"
  586.     $w.btns button apply  config -command "$w.fsb filter" -text Filter
  587.     $w.btns button cancel config -command "wm withdraw $w"
  588.     if {$helpcmd == {}} {
  589.     $w.btns button help config -state disabled
  590.     } else {
  591.     $w.btns button help config -command $helpcmd
  592.     }
  593.     wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
  594.     pack $w.btns  -side bottom -fill both
  595.     pack $w.fsb   -fill both -expand yes
  596.  
  597.     return $w.fsb
  598. }
  599.